 Loading |
|
Loading |
| VBScript |
| JavaScript |
| Powershell |
Search Options: Zip (compress) Files
|
||
|
'#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#'
'/| |\\\\\\\\' '//| |\\\\\\\' '///| |\\\\\\' '////| Version 1.0.0 |\\\\\' '/////| Author: Boris TOll |\\\\' '//////| Last Update: 15.05.2008 |\\\' '///////| |\\' '////////| |\' '#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#*~#' ' ' # Description:: Drag & drop the Files to zip over the Script Dim ofso : Set ofso = Createobject("Scripting.FileSystemObject") Dim oWshShell : Set oWshShell = WScript.CreateObject("WSCript.shell") Dim oApp : Set oApp = CreateObject("Shell.Application") Const ForReading = 1 Const ForWriting = 2 Const ForAppending = 8 Dim strZipTempPath : strZipTempPath = oWshShell.ExpandEnvironmentStrings("%Temp%") & "\$tmpZip" Call GetArguments(ArgArray) If IsArray(ArgArray) then Dim strZipFile : strZipFile = SaveFile() If strZipFile > "" then If not UCase(Right(strZipFile, 4)) = ".ZIP" then strZipFile = strZipFile & ".zip" End if For Each ArrayElement In ArgArray If ofso.FileExists(ArrayElement) then Call Zip(ArrayElement, strZipFile) End if Next wscript.echo "Zipfile " & strZipFile & VbCrLf & "wurde erstellt!" Else wscript.echo "Script wurde abgebrochen!" wscript.quit End if End if ' --------------------------------------- Private Function Zip(strFile, strZipFile) If not ofso.FileExists(strZipFile) then Set oZip = ofso.OpenTextFile(strZipFile, ForWriting, True ) oZip.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) ) oZip.Close WScript.Sleep 2500 End if tmpCount = oApp.NameSpace(strZipFile).Items.Count +1 For Each Item in oApp.NameSpace(strZipFile).Items If UCase(Item) = Ucase(ofso.GetFile(strFile).Name) then tmpCount = oApp.NameSpace(strZipFile).Items.Count WScript.Sleep 5000 Exit For End if Next oApp.NameSpace(strZipFile).CopyHere strFile Do Until oApp.NameSpace(strZipFile).Items.Count = tmpCount WScript.Sleep 500 Loop End Function ' ---------------------------------------- Private Function GetArguments(SourceArray) Dim iCount : iCount = 0 If wscript.arguments.count > 0 then ReDim ArgArray(wscript.arguments.count -1) For Each Argument in wscript.arguments ArgArray(iCount) = Argument iCount = iCount +1 Next iCount = Null GetArguments = ArgArray End if End Function ' ------------------------- Private Function SaveFile() On Error Resume Next Dim ofso : Set ofso = CreateObject("Scripting.FileSystemObject") Dim oDlg : set oDlg = Wscript.CreateObject("MSComDlg.CommonDialog") Dim iRet If Err.Number <> 0 then Err.Clear Set oDlg = CreateObject("UserAccounts.CommonDialog") If Err.Number <> 0 then MsgBox "Notwendige Runtimes sind nicht vorhanden, Script wird beendet.",16 , "Info" WScript.Quit End if End if oDlg.Filter = "Zip Files (*.zip)|*.zip" oDlg.FilterIndex = 1 oDlg.MaxFileSize = 10000 oDlg.CancelError = true oDlg.ShowSave If oDlg.Filename > "" then If ofso.FileExists(oDlg.Filename) then iRet = MsgBox("Zipfile ist bereits vorhanden, wollen Sie die Dateien anhängen?",68 , "Info") If iRet = 6 then SaveFile = oDlg.Filename End if Else SaveFile = oDlg.Filename End if Else SaveFile = "" End if End Function | ||
© 2008 - 2013 Boris Toll :: Scripts available: 6.481 :: :: scriptbox.toll.at :: :: powered by www.toll.at :: | ||
